home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Tutorial Material / Pitch and Rhythm Tutorial / 12 tone row -text < prev    next >
Lisp/Scheme  |  1998-10-26  |  4KB  |  137 lines
  1. ; A template for 12 note pre-composition
  2.  
  3. ; - this programme allows you to generate pitch class information as text.
  4. ; - Write in your row , Starting pitch and Pitch Class Numbers
  5.  
  6. (setq row '(a c d f e h i g b l j k))
  7. (setq pitch (activate-tonality (chromatic e 5)))
  8. (setq pcnos '((0 2 3 5 4 7 8 6 1 11 9 10)))
  9.  
  10. ; - transposition 
  11.  
  12. (setq row-ta (symbol-transpose 0 row))
  13. (setq row-tb (symbol-transpose 1 row))
  14. (setq row-tc (symbol-transpose 2 row))
  15. (setq row-td (symbol-transpose 3 row))
  16. (setq row-te (symbol-transpose 4 row))
  17. (setq row-tf (symbol-transpose 5 row))
  18. (setq row-tg (symbol-transpose -6 row))
  19. (setq row-th (symbol-transpose -5 row))
  20. (setq row-ti (symbol-transpose -4 row))
  21. (setq row-tj (symbol-transpose -3 row))
  22. (setq row-tk (symbol-transpose -2 row))
  23. (setq row-tl (symbol-transpose -1 row))
  24.  
  25. (setq rowt (append row-ta row-tb row-tc row-td row-te
  26.         row-tf row-tg row-th row-ti row-tj row-tk row-tl))
  27.  
  28.  
  29. (setq rt-all 
  30.       (flatten
  31.            (symbols-to-tonality
  32.                 symbols row-ta
  33.                 transpose '((0))
  34.                 mapping pitch
  35.             )))
  36.  
  37. ; - retrogression
  38.  
  39. (setq row-ra (symbol-retrograde row-ta))
  40. (setq row-rb (symbol-retrograde row-tb))
  41. (setq row-rc (symbol-retrograde row-tc))
  42. (setq row-rd (symbol-retrograde row-td))
  43. (setq row-re (symbol-retrograde row-te))
  44. (setq row-rf (symbol-retrograde row-tf))
  45. (setq row-rg (symbol-retrograde row-tg))
  46. (setq row-rh (symbol-retrograde row-th))
  47. (setq row-ri (symbol-retrograde row-ti))
  48. (setq row-rj (symbol-retrograde row-tj))
  49. (setq row-rk (symbol-retrograde row-tk))
  50. (setq row-rl (symbol-retrograde row-tl))
  51.  
  52. (setq rowr (append row-ra row-rb row-rc row-rd row-re 
  53.         row-rf row-rg row-rh row-ri row-rj row-rk row-rl))
  54.  
  55. (setq rr-all 
  56.     (flatten
  57.          (symbols-to-tonality
  58.               symbols row-ra
  59.               transpose '((0))
  60.               mapping pitch)))
  61.  
  62. ; - inversion
  63.  
  64. (setq row-ia (symbol-transpose 12 (symbol-inversion 'a row)))
  65. (setq row-ib (symbol-transpose 11 (symbol-inversion 'b row)))
  66. (setq row-ic (symbol-transpose 10 (symbol-inversion 'c row)))
  67. (setq row-id (symbol-transpose 9 (symbol-inversion 'd row)))
  68. (setq row-ie (symbol-transpose 8 (symbol-inversion 'e row)))
  69. (setq row-if (symbol-transpose 7 (symbol-inversion 'f row)))
  70. (setq row-ig (symbol-transpose 6 (symbol-inversion 'g row)))
  71. (setq row-ih (symbol-transpose 5 (symbol-inversion 'h row)))
  72. (setq row-ii (symbol-transpose 4 (symbol-inversion 'i row)))
  73. (setq row-ij (symbol-transpose 3 (symbol-inversion 'j row)))
  74. (setq row-ik (symbol-transpose 2 (symbol-inversion 'k row)))
  75. (setq row-il (symbol-transpose 1 (symbol-inversion 'l row)))
  76.  
  77. (setq rowi (append row-ia row-ib row-ic row-id row-ie 
  78.         row-if row-ig row-ih row-ii row-ij row-ik row-il))
  79.  
  80. (setq ri-all 
  81.       (flatten
  82.            (symbols-to-tonality
  83.                 symbol row-ia
  84.                 transpose '((0))
  85.                 mapping pitch)))
  86.  
  87. ; - retrograde-inversion
  88.  
  89. (setq row-ria 
  90.       (symbol-retrograde
  91.            (symbol-transpose 12 (symbol-inversion 'a row))))
  92. (setq row-rib 
  93.       (symbol-retrograde
  94.            (symbol-transpose 11 (symbol-inversion 'b row))))
  95. (setq row-ric 
  96.       (symbol-retrograde
  97.            (symbol-transpose 10 (symbol-inversion 'c row))))
  98. (setq row-rid 
  99.       (symbol-retrograde
  100.            (symbol-transpose 9 (symbol-inversion 'd row))))
  101. (setq row-rie 
  102.       (symbol-retrograde
  103.            (symbol-transpose 8 (symbol-inversion 'e row))))
  104. (setq row-rif 
  105.       (symbol-retrograde
  106.            (symbol-transpose 7 (symbol-inversion 'f row))))
  107. (setq row-rig 
  108.       (symbol-retrograde
  109.            (symbol-transpose 6 (symbol-inversion 'g row))))
  110. (setq row-rih 
  111.       (symbol-retrograde
  112.            (symbol-transpose 5 (symbol-inversion 'h row))))
  113. (setq row-rii 
  114.       (symbol-retrograde
  115.            (symbol-transpose 4 (symbol-inversion 'i row))))
  116. (setq row-rij 
  117.       (symbol-retrograde
  118.            (symbol-transpose 3 (symbol-inversion 'j row))))
  119. (setq row-rik 
  120.       (symbol-retrograde
  121.            (symbol-transpose 2 (symbol-inversion 'k row))))
  122. (setq row-ril 
  123.       (symbol-retrograde
  124.            (symbol-transpose 1 (symbol-inversion 'l row))))
  125.  
  126. (setq rowri (append row-ria row-rib row-ric row-rid row-rie 
  127.         row-rif row-rig row-rih row-rii row-rij row-rik row-ril))
  128.  
  129. (setq rri-all 
  130.       (flatten
  131.            (symbols-to-tonality
  132.                 symbols row-ria
  133.                 transpose '((0))
  134.                 mapping pitch)))
  135.  
  136.  
  137.